home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 26 / Cream of the Crop 26.iso / os2 / pvm34b3.zip / pvm34b3 / pvm3 / examples / master1.f < prev    next >
Text File  |  1997-07-22  |  3KB  |  99 lines
  1. c
  2. c $Id: master1.f,v 1.2 1997/06/26 19:42:55 pvmsrc Exp $
  3. c
  4.       program master1 
  5.       include '../include/fpvm3.h'
  6. c ---------------------------------------------------------
  7. c Example fortran program illustrating the use of PVM 3
  8. c ---------------------------------------------------------
  9.       integer i, info, nproc, nhost, msgtype
  10.       integer mytid, iptid, dtid, tids(0:32)
  11.       integer who, speed
  12.       double precision result(32), data(100)
  13.       character*18 nodename, host
  14.       character*8 arch
  15.  
  16. c ------------ Starting up all the tasks ---------------------------
  17.  
  18. c     Enroll this program in PVM 
  19.       call pvmfmytid( mytid )
  20.  
  21. c     Set number of slaves to spawn. 
  22. c     Note standard input cannot be read if spawned from console, so just
  23. c     derive nprocs from the VM config
  24.       call pvmfconfig( nhost, narch, dtid, host, arch, speed, info )
  25.       nproc = nhost * 3
  26.       if( nproc .gt. 32 ) nproc = 32
  27. c
  28. c     Initiate nproc instances of slave1 program 
  29. c     If arch is set to '*' then ANY configured machine is acceptable
  30.       write(6,6000) nproc
  31. 6000  format(' ','Spawning ', I4, ' tasks ...')
  32. 6001  format(' ',25X, 'SUCCESSFUL')
  33.       nodename = 'fslave1'
  34.       arch = '*'
  35.       call pvmfspawn( nodename, PVMDEFAULT, arch, nproc, tids, numt )
  36.  
  37. c     Check for problems
  38. 100   continue
  39.       if( numt .lt. nproc ) then
  40.          print *, 'trouble spawning ',nodename
  41.          print *, ' Check tids for error code'
  42.          call shutdown( numt, tids )
  43.       endif
  44.  
  45.       write(6,6001)
  46.  
  47. c ------- Begin user program -------- 
  48.  
  49.       n = 100
  50. c     Initiate data array
  51.       do 20 i=1,n
  52.          data(i) = 1
  53.  20   continue
  54.  
  55. c     broadcast data to all node programs 
  56.       call pvmfinitsend( PVMDEFAULT, info )
  57.       call pvmfpack( INTEGER4, nproc, 1, 1, info )
  58.       call pvmfpack( INTEGER4, tids, nproc, 1, info )
  59.       call pvmfpack( INTEGER4, n, 1, 1, info )
  60.       call pvmfpack( REAL8,    data, n, 1, info ) 
  61.       msgtype  = 1 
  62.       call pvmfmcast( nproc, tids, msgtype, info )
  63.  
  64. c     wait for results from nodes 
  65.       msgtype  = 2 
  66.       do 30 i=1,nproc 
  67.          call pvmfrecv( -1, msgtype, info ) 
  68.          call pvmfunpack( INTEGER4, who, 1, 1, info )
  69.          call pvmfunpack( REAL8, result(who+1), 1, 1, info )
  70.          if (who .eq. 0) then
  71.             write(6,6002)  result(who+1), who, (nproc - 1) * 100.0
  72.          else
  73.             write(6,6002) result(who+1), who,  (2 * who - 1) * 100.0
  74.          endif
  75.  6002    format(' ', 'I got ', F15.7, ' from', I4,
  76.      +                ' (expected ',F15.7,' )')
  77.     
  78.  30   continue 
  79.  
  80. c --------- End user program -------- 
  81.  
  82. c     program finished leave PVM before exiting 
  83.       call pvmfexit(info) 
  84.       stop
  85.       end
  86.  
  87.       subroutine shutdown( nproc, tids )
  88.       integer nproc, tids(*)
  89. c
  90. c     Kill all tasks I spawned and then myself
  91. c
  92.       do 10 i=0, nproc
  93.          call pvmfkill( tids(i), info )
  94.   10  continue
  95.       call pvmfexit( info )
  96.       stop
  97.       return
  98.       end
  99.